home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / jade / src / symbols.c < prev    next >
C/C++ Source or Header  |  1995-03-09  |  30KB  |  1,194 lines
  1. /* symbols.c -- Lisp symbol handling
  2.    Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4.    This file is part of Jade.
  5.  
  6.    Jade is free software; you can redistribute it and/or modify it
  7.    under the terms of the GNU General Public License as published by
  8.    the Free Software Foundation; either version 2, or (at your option)
  9.    any later version.
  10.  
  11.    Jade is distributed in the hope that it will be useful, but
  12.    WITHOUT ANY WARRANTY; without even the implied warranty of
  13.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.    GNU General Public License for more details.
  15.  
  16.    You should have received a copy of the GNU General Public License
  17.    along with Jade; see the file COPYING.  If not, write to
  18.    the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. #include "jade.h"
  21. #include "jade_protos.h"
  22. #include "regexp/regexp.h"
  23.  
  24. #include <string.h>
  25. #include <ctype.h>
  26. #include <stdlib.h>
  27.  
  28. /* The special value which signifies the end of a hash-bucket chain.
  29.    It can be any Lisp object which isn't a symbol.  */
  30. #define OB_NIL null_string
  31.  
  32. _PR void symbol_sweep(void);
  33. _PR int symbol_cmp(VALUE, VALUE);
  34. _PR void symbol_princ(VALUE, VALUE);
  35. _PR void symbol_print(VALUE, VALUE);
  36. _PR VALUE add_subr(XSubr *);
  37. _PR VALUE add_const_num(VALUE, long);
  38. _PR void intern_static(VALUE *, VALUE);
  39. _PR VALUE bind_symbol(VALUE, VALUE, VALUE);
  40. _PR void unbind_symbols(VALUE);
  41. _PR int symbols_init(void);
  42. _PR void symbols_kill(void);
  43.  
  44. /* Main storage of symbols.  */
  45. _PR VALUE obarray;
  46. VALUE obarray;
  47.  
  48. _PR VALUE sym_nil, sym_t;
  49. VALUE sym_nil, sym_t;
  50.  
  51. _PR VALUE sym_variable_documentation;
  52. VALUE sym_variable_documentation;
  53.  
  54. /* This value is stored in the cells of a symbol to denote a void object. */
  55. _PR VALUE void_value;
  56. static LispObject void_object = { V_Void };
  57. VALUE void_value = &void_object;
  58.  
  59. static SymbolBlk *symbol_block_chain;
  60. static Symbol *symbol_freelist;
  61. _PR int allocated_symbols, used_symbols;
  62. int allocated_symbols, used_symbols;
  63.  
  64. _PR VALUE cmd_make_symbol(VALUE);
  65. DEFUN("make-symbol", cmd_make_symbol, subr_make_symbol, (VALUE name), V_Subr1, DOC_make_symbol) /*
  66. ::doc:make_symbol::
  67. make-symbol NAME
  68.  
  69. Returns a new, uninterned, symbol with print-name NAME. It's value and
  70. function definition are both void and it has a nil property-list.
  71. ::end:: */
  72. {
  73.     VALUE sym;
  74.     DECLARE1(name, STRINGP);
  75.     if(!symbol_freelist)
  76.     {
  77.     SymbolBlk *sb = mycalloc(sizeof(SymbolBlk));
  78.     if(sb)
  79.     {
  80.         int i;
  81.         allocated_symbols += SYMBOLBLK_SIZE;
  82.         sb->sb_Next = symbol_block_chain;
  83.         symbol_block_chain = sb;
  84.         for(i = 0; i < (SYMBOLBLK_SIZE - 1); i++)
  85.         sb->sb_Symbols[i].sym_Next = VAL(&sb->sb_Symbols[i + 1]);
  86.         sb->sb_Symbols[i].sym_Next = VAL(symbol_freelist);
  87.         symbol_freelist = sb->sb_Symbols;
  88.     }
  89.     }
  90.     if((sym = VAL(symbol_freelist)))
  91.     {
  92.     symbol_freelist = VSYM(VSYM(sym)->sym_Next);
  93.     VSYM(sym)->sym_Next = NULL;
  94.     VSYM(sym)->sym_Type = V_Symbol;
  95.     VSYM(sym)->sym_Flags = 0;
  96.     VSYM(sym)->sym_Name = name;
  97.     VSYM(sym)->sym_Value = void_value;
  98.     VSYM(sym)->sym_Function = void_value;
  99.     VSYM(sym)->sym_PropList = sym_nil;
  100.     used_symbols++;
  101.     data_after_gc += sizeof(Symbol);
  102.     }
  103.     return(sym);
  104. }
  105.  
  106. void
  107. symbol_sweep(void)
  108. {
  109.     SymbolBlk *sb = symbol_block_chain;
  110.     symbol_freelist = NULL;
  111.     used_symbols = 0;
  112.     while(sb)
  113.     {
  114.     int i;
  115.     SymbolBlk *nxt = sb->sb_Next;
  116.     for(i = 0; i < SYMBOLBLK_SIZE; i++)
  117.     {
  118.         if(!GC_MARKEDP(VAL(&sb->sb_Symbols[i])))
  119.         {
  120.         sb->sb_Symbols[i].sym_Next = VAL(symbol_freelist);
  121.         symbol_freelist = &sb->sb_Symbols[i];
  122.         }
  123.         else
  124.         {
  125.         GC_CLR(VAL(&sb->sb_Symbols[i]));
  126.         used_symbols++;
  127.         }
  128.     }
  129.     sb = nxt;
  130.     }
  131. }
  132.  
  133. int
  134. symbol_cmp(VALUE v1, VALUE v2)
  135. {
  136.     if(VTYPE(v1) == VTYPE(v2))
  137.     return(!(VSYM(v1) == VSYM(v2)));
  138.     return(1);
  139. }
  140.  
  141. void
  142. symbol_princ(VALUE strm, VALUE obj)
  143. {
  144.     stream_puts(strm, VSTR(VSYM(obj)->sym_Name), -1, TRUE);
  145. }
  146.  
  147. void
  148. symbol_print(VALUE strm, VALUE obj)
  149. {
  150.     u_char *s = VSTR(VSYM(obj)->sym_Name);
  151.     u_char c;
  152.     while((c = *s++))
  153.     {
  154.     switch(c)
  155.     {
  156.     case ' ':
  157.     case '\t':
  158.     case '\n':
  159.     case '\f':
  160.     case '(':
  161.     case ')':
  162.     case '[':
  163.     case ']':
  164.     case '\'':
  165.     case '"':
  166.     case ';':
  167.     case '\\':
  168.     case '|':
  169.         stream_putc(strm, (int)'\\');
  170.         break;
  171.     default:
  172.         if(iscntrl(c))
  173.         stream_putc(strm, (int)'\\');
  174.         break;
  175.     }
  176.     stream_putc(strm, (int)c);
  177.     }
  178. }
  179.  
  180. VALUE
  181. add_subr(XSubr *subr)
  182. {
  183.     VALUE sym = cmd_intern(subr->subr_Name, obarray);
  184.     if(sym)
  185.     {
  186.     if(subr->subr_Type == V_Var)
  187.     {
  188.         VSYM(sym)->sym_Value = VAL(subr);
  189.         VSYM(sym)->sym_PropList = cmd_cons(sym_variable_documentation, cmd_cons(make_number(subr->subr_DocIndex), VSYM(sym)->sym_PropList));
  190.     }
  191.     else
  192.         VSYM(sym)->sym_Function = VAL(subr);
  193.     }
  194.     return(sym);
  195. }
  196.  
  197. VALUE
  198. add_const_num(VALUE name, long num)
  199. {
  200.     VALUE sym = cmd_intern(name, obarray);
  201.     if(sym)
  202.     {
  203.     VSYM(sym)->sym_Value = make_number(num);
  204.     VSYM(sym)->sym_Flags |= SF_CONSTANT;
  205.     }
  206.     return(sym);
  207. }
  208.  
  209. void
  210. intern_static(VALUE *symp, VALUE name)
  211. {
  212.     if((*symp = cmd_intern(name, sym_nil)))
  213.     mark_static(symp);
  214.     else
  215.     abort();
  216. }
  217.  
  218. static INLINE u_long
  219. hash(u_char *str)
  220. {
  221.     register u_long value = 0;
  222.     while(*str)
  223.     value = (value * 33) + *str++;
  224.     return(value);
  225. }
  226.  
  227. _PR VALUE cmd_make_obarray(VALUE);
  228. DEFUN("make-obarray", cmd_make_obarray, subr_make_obarray, (VALUE size), V_Subr1, DOC_make_obarray) /*
  229. ::doc:make_obarray::
  230. make-obarray SIZE
  231.  
  232. Creates a new structure for storing symbols in. This is basically a vector
  233. with a few slight differences (all elements initialised to a special value).
  234. ::end:: */
  235. {
  236.     DECLARE1(size, NUMBERP);
  237.     return(cmd_make_vector(size, OB_NIL));
  238. }
  239.  
  240. _PR VALUE cmd_find_symbol(VALUE, VALUE);
  241. DEFUN("find-symbol", cmd_find_symbol, subr_find_symbol, (VALUE name, VALUE ob), V_Subr2, DOC_find_symbol) /*
  242. ::doc:find_symbol::
  243. find-symbol NAME [OBARRAY]
  244.  
  245. Returns the symbol with print-name NAME, found by searching OBARRAY (or
  246. the default `obarray' if nil), or nil if no such symbol exists.
  247. ::end:: */
  248. {
  249.     int vsize;
  250.     DECLARE1(name, STRINGP);
  251.     if(!VECTORP(ob))
  252.     ob = obarray;
  253.     if((vsize = VVECT(ob)->vc_Size) == 0)
  254.     return(sym_nil);
  255.     ob = VVECT(ob)->vc_Array[hash(VSTR(name)) % vsize];
  256.     while(SYMBOLP(ob))
  257.     {
  258.     if(!strcmp(VSTR(name), VSTR(VSYM(ob)->sym_Name)))
  259.         return(ob);
  260.     ob = VSYM(ob)->sym_Next;
  261.     }
  262.     return(sym_nil);
  263. }
  264.  
  265. _PR VALUE cmd_intern_symbol(VALUE, VALUE);
  266. DEFUN("intern-symbol", cmd_intern_symbol, subr_intern_symbol, (VALUE sym, VALUE ob), V_Subr2, DOC_intern_symbol) /*
  267. ::doc:intern_symbol::
  268. intern-symbol SYMBOL [OBARRAY]
  269.  
  270. Stores SYMBOL in OBARRAY (or the default). If SYMBOL has already been interned
  271. somewhere an error is signalled.
  272. ::end:: */
  273. {
  274.     int vsize, hashid;
  275.     DECLARE1(sym, SYMBOLP);
  276.     if(VSYM(sym)->sym_Next != NULL)
  277.     {
  278.     cmd_signal(sym_error, list_2(MKSTR("Symbol is already interned"), sym));
  279.     return(NULL);
  280.     }
  281.     if(!VECTORP(ob))
  282.     ob = obarray;
  283.     if((vsize = VVECT(ob)->vc_Size) == 0)
  284.     return(NULL);
  285.     hashid = hash(VSTR(VSYM(sym)->sym_Name)) % vsize;
  286.     VSYM(sym)->sym_Next = VVECT(ob)->vc_Array[hashid];
  287.     VVECT(ob)->vc_Array[hashid] = sym;
  288.     return(sym);
  289. }
  290.  
  291. _PR VALUE cmd_intern(VALUE, VALUE);
  292. DEFUN("intern", cmd_intern, subr_intern, (VALUE name, VALUE ob), V_Subr2, DOC_intern) /*
  293. ::doc:intern::
  294. intern NAME [OBARRAY]
  295.  
  296. If a symbol with print-name exists in OBARRAY (or the default) return it.
  297. Else use `(make-symbol NAME)' to create a new symbol, intern that into the
  298. OBARRAY, then return it.
  299. ::end:: */
  300. {
  301.     VALUE sym;
  302.     DECLARE1(name, STRINGP);
  303.     if(!(sym = cmd_find_symbol(name, ob))
  304.        || (NILP(sym) && strcmp(VSTR(name), "nil")))
  305.     {
  306.     sym = cmd_make_symbol(name);
  307.     if(sym)
  308.         return(cmd_intern_symbol(sym, ob));
  309.     }
  310.     return(sym);
  311. }
  312.  
  313. _PR VALUE cmd_unintern(VALUE, VALUE);
  314. DEFUN("unintern", cmd_unintern, subr_unintern, (VALUE sym, VALUE ob), V_Subr2, DOC_unintern) /*
  315. ::doc:unintern::
  316. unintern SYMBOL [OBARRAY]
  317.  
  318. Removes SYMBOL from OBARRAY (or the default). Use this with caution.
  319. ::end:: */
  320. {
  321.     VALUE list;
  322.     int vsize, hashid;
  323.     DECLARE1(sym, SYMBOLP);
  324.     if(!VECTORP(ob))
  325.     ob = obarray;
  326.     if((vsize = VVECT(ob)->vc_Size) == 0)
  327.     return(NULL);
  328.     hashid = hash(VSTR(VSYM(sym)->sym_Name)) % vsize;
  329.     list = VVECT(ob)->vc_Array[hashid];
  330.     VVECT(ob)->vc_Array[hashid] = NULL;
  331.     while(SYMBOLP(list))
  332.     {
  333.     VALUE nxt = VSYM(list)->sym_Next;
  334.     if(list != sym)
  335.     {
  336.         VSYM(list)->sym_Next = VVECT(ob)->vc_Array[hashid];
  337.         VVECT(ob)->vc_Array[hashid] = VAL(list);
  338.     }
  339.     list = nxt;
  340.     }
  341.     VSYM(sym)->sym_Next = NULL;
  342.     return(sym);
  343. }
  344.  
  345. /* This give SYMBOL a new value, saving the old one onto the front of
  346.    the list OLDLIST. OLDLIST is structured like,
  347.      ((SYMBOL . OLDVALUE) ...)
  348.    Returns the new version of OLDLIST.   */
  349. VALUE
  350. bind_symbol(VALUE oldList, VALUE symbol, VALUE newVal)
  351. {
  352.     VALUE newbl = cmd_cons(cmd_cons(symbol, sym_nil), oldList);
  353.     if(newbl)
  354.     {
  355.     /* Binding to buffer-local values is a recipe for disaster; when
  356.        the binding is removed the current buffer may be different to
  357.        when the binding was created. This would result in the wrong
  358.        value being removed. So binding always works on the *default*
  359.        value of a variable; this also won't work properly with
  360.        buffer-local variables but hopefully it's less destructive... */
  361.     VCDR(VCAR(newbl)) = cmd_default_value(symbol, sym_t);
  362.     cmd_set_default(symbol, newVal);
  363.     }
  364.     return(newbl);
  365. }
  366.  
  367. /* Undoes what the above function does.  */
  368. void
  369. unbind_symbols(VALUE oldList)
  370. {
  371.     while(CONSP(oldList))
  372.     {
  373.     VALUE tmp = VCAR(oldList);
  374.     cmd_set_default(VCAR(tmp), VCDR(tmp));
  375.     oldList = VCDR(oldList);
  376.     }
  377. }
  378.  
  379. _PR VALUE cmd_symbol_value(VALUE, VALUE);
  380. DEFUN("symbol-value", cmd_symbol_value, subr_symbol_value, (VALUE sym, VALUE no_err), V_Subr2, DOC_symbol_value) /*
  381. ::doc:symbol_value::
  382. symbol-value SYMBOL
  383.  
  384. Returns the value of SYMBOL, if SYMBOL is flagged as having buffer-local
  385. values look for one of those first.
  386. ::end:: */
  387. /* Second argument (NO-ERR) means don't signal an error if the value is
  388.    void. */
  389. {
  390.     VALUE val;
  391.     DECLARE1(sym, SYMBOLP);
  392.     if((VSYM(sym)->sym_Flags & SF_BUFFER_LOCAL)
  393.        && (val = cmd_assq(sym, curr_vw->vw_Tx->tx_LocalVariables))
  394.        && CONSP(val))
  395.     {
  396.     val = VCDR(val);
  397.     }
  398.     else
  399.     val = VSYM(sym)->sym_Value;
  400.     if(val && (VTYPE(val) == V_Var))
  401.     {
  402.     val = VVARFUN(val)(NULL);
  403.     if(val == NULL)
  404.         val = void_value;
  405.     }
  406.     if(NILP(no_err) && (VOIDP(val)))
  407.     return(cmd_signal(sym_void_value, LIST_1(sym)));
  408.     else
  409.     return(val);
  410. }
  411.  
  412. _PR VALUE cmd_set(VALUE, VALUE);
  413. DEFUN_INT("set", cmd_set, subr_set, (VALUE sym, VALUE val), V_Subr2, DOC_set, "vVariable:\nxNew value of %s:") /*
  414. ::doc:set::
  415. set SYMBOL VALUE
  416.  
  417. Sets the value of SYMBOL to VALUE. If SYMBOL has a buffer-local binding
  418. in the current buffer or `make-variable-buffer-local' has been called on
  419. SYMBOL the buffer-local value in the current buffer is set. Returns VALUE.
  420. ::end:: */
  421. {
  422.     DECLARE1(sym, SYMBOLP);
  423.     if(VSYM(sym)->sym_Flags & SF_CONSTANT)
  424.     return(cmd_signal(sym_setting_constant, LIST_1(sym)));
  425.     if(VSYM(sym)->sym_Flags & SF_BUFFER_LOCAL)
  426.     {
  427.     TX *tx = curr_vw->vw_Tx;
  428.     VALUE tmp;
  429.     if((tmp = cmd_assq(sym, tx->tx_LocalVariables)) && CONSP(tmp))
  430.     {
  431.         /* A buffer-local value exists, modify it. */
  432.         VCDR(tmp) = val;
  433.         return(val);
  434.     }
  435.     else if(VSYM(sym)->sym_Flags & SF_SET_BUFFER_LOCAL)
  436.     {
  437.         /* Create a new buffer-local value */
  438.         tx->tx_LocalVariables = cmd_cons(cmd_cons(sym, val),
  439.                          tx->tx_LocalVariables);
  440.         return(val);
  441.     }
  442.     /* Fall through and set the default value. */
  443.     }
  444.     if(VSYM(sym)->sym_Value && (VTYPE(VSYM(sym)->sym_Value) == V_Var))
  445.     VVARFUN(VSYM(sym)->sym_Value)(val);
  446.     else
  447.     VSYM(sym)->sym_Value = val;
  448.     return(val);
  449. }
  450.  
  451. _PR VALUE cmd_setplist(VALUE, VALUE);
  452. DEFUN("setplist", cmd_setplist, subr_setplist, (VALUE sym, VALUE prop), V_Subr2, DOC_setplist) /*
  453. ::doc:setplist::
  454. setplist SYMBOL PROP-LIST
  455.  
  456. Sets the property list of SYMBOL to PROP-LIST, returns PROP-LIST.
  457. ::end:: */
  458. {
  459.     DECLARE1(sym, SYMBOLP);
  460.     VSYM(sym)->sym_PropList = prop;
  461.     return(prop);
  462. }
  463.  
  464. _PR VALUE cmd_symbol_name(VALUE);
  465. DEFUN("symbol-name", cmd_symbol_name, subr_symbol_name, (VALUE sym), V_Subr1, DOC_symbol_name) /*
  466. ::doc:symbol_name::
  467. symbol-name SYMBOL
  468.  
  469. Returns the print-name of SYMBOL.
  470. ::end:: */
  471. {
  472.     DECLARE1(sym, SYMBOLP);
  473.     return(VSYM(sym)->sym_Name);
  474. }
  475.  
  476. _PR VALUE cmd_symbol_function(VALUE, VALUE);
  477. DEFUN("symbol-function", cmd_symbol_function, subr_symbol_function, (VALUE sym, VALUE no_err), V_Subr2, DOC_symbol_function) /*
  478. ::doc:symbol_function::
  479. symbol-function SYMBOL
  480.  
  481. Returns the function value of SYMBOL.
  482. ::end:: */
  483. {
  484.     DECLARE1(sym, SYMBOLP);
  485.     if(NILP(no_err) && (VOIDP(VSYM(sym)->sym_Function)))
  486.     return(cmd_signal(sym_void_function, LIST_1(sym)));
  487.     else
  488.     return(VSYM(sym)->sym_Function);
  489. }
  490.  
  491. _PR VALUE cmd_default_value(VALUE, VALUE);
  492. DEFUN("default-value", cmd_default_value, subr_default_value, (VALUE sym, VALUE no_err), V_Subr2, DOC_default_value) /*
  493. ::doc:default_value::
  494. default-value SYMBOL
  495.  
  496. Returns the default value of the symbol SYMBOL. This will be the value of
  497. SYMBOL in buffers or windows which do not have their own local value.
  498. ::end:: */
  499. {
  500.     VALUE val;
  501.     DECLARE1(sym, SYMBOLP);
  502.     if(VSYM(sym)->sym_Value && (VTYPE(VSYM(sym)->sym_Value) == V_Var))
  503.     val = VVARFUN(VSYM(sym)->sym_Value)(NULL);
  504.     else
  505.     val = VSYM(sym)->sym_Value;
  506.     if(NILP(no_err) && VOIDP(val))
  507.     return(cmd_signal(sym_void_value, LIST_1(sym)));
  508.     else
  509.     return(val);
  510. }
  511.  
  512. _PR VALUE cmd_default_boundp(VALUE);
  513. DEFUN("default-boundp", cmd_default_boundp, subr_default_boundp, (VALUE sym), V_Subr1, DOC_default_boundp) /*
  514. ::doc:default_boundp::
  515. default-boundp SYMBOL
  516.  
  517. Returns t if SYMBOL has a default value.
  518. ::end:: */
  519. {
  520.     DECLARE1(sym, SYMBOLP);
  521.     return((VOIDP(VSYM(sym)->sym_Value)) ? sym_nil : sym_t);
  522. }
  523.  
  524. _PR VALUE cmd_set_default(VALUE, VALUE);
  525. DEFUN("set-default", cmd_set_default, subr_set_default, (VALUE sym, VALUE val), V_Subr2, DOC_set_default) /*
  526. ::doc:set_default::
  527. set-default SYMBOL VALUE
  528.  
  529. Sets the default value of SYMBOL to VALUE, then returns VALUE.
  530. ::end:: */
  531. {
  532.     DECLARE1(sym, SYMBOLP);
  533.     if(VSYM(sym)->sym_Value && (VTYPE(VSYM(sym)->sym_Value) == V_Var))
  534.     VVARFUN(VSYM(sym)->sym_Value)(val);
  535.     else
  536.     VSYM(sym)->sym_Value = val;
  537.     return(val);
  538. }
  539.  
  540. _PR VALUE cmd_fboundp(VALUE);
  541. DEFUN("fboundp", cmd_fboundp, subr_fboundp, (VALUE sym), V_Subr1, DOC_fboundp) /*
  542. ::doc:fboundp::
  543. fboundp SYMBOL
  544.  
  545. Returns t if the function-slot of SYMBOL has a value.
  546. ::end:: */
  547. {
  548.     DECLARE1(sym, SYMBOLP);
  549.     return(VOIDP(cmd_symbol_function(sym, sym_t)) ? sym_nil : sym_t);
  550. }
  551.  
  552. _PR VALUE cmd_boundp(VALUE);
  553. DEFUN("boundp", cmd_boundp, subr_boundp, (VALUE sym), V_Subr1, DOC_boundp) /*
  554. ::doc:boundp::
  555. boundp SYMBOL
  556.  
  557. Returns t if SYMBOL has a value as a variable.
  558. ::end:: */
  559. {
  560.     DECLARE1(sym, SYMBOLP);
  561.     return(VOIDP(cmd_symbol_value(sym, sym_t)) ? sym_nil : sym_t);
  562. }
  563.  
  564. _PR VALUE cmd_symbol_plist(VALUE);
  565. DEFUN("symbol-plist", cmd_symbol_plist, subr_symbol_plist, (VALUE sym), V_Subr1, DOC_symbol_plist) /*
  566. ::doc:symbol_plist::
  567. symbol-plist SYMBOL
  568.  
  569. Returns the property-list of SYMBOL.
  570. ::end:: */
  571. {
  572.     DECLARE1(sym, SYMBOLP);
  573.     return(VSYM(sym)->sym_PropList);
  574. }
  575.  
  576. _PR VALUE cmd_gensym(void);
  577. DEFUN("gensym", cmd_gensym, subr_gensym, (void), V_Subr0, DOC_gensym) /*
  578. ::doc:gensym::
  579. gensym
  580.  
  581. Returns a new (non-interned) symbol with a unique print name.
  582. ::end:: */
  583. {
  584.     static int counter;
  585.     char buf[20];
  586.     counter++;
  587.     sprintf(buf, "G%04d", counter);
  588.     return(cmd_make_symbol(string_dup(buf)));
  589. }
  590.  
  591. _PR VALUE cmd_symbolp(VALUE);
  592. DEFUN("symbolp", cmd_symbolp, subr_symbolp, (VALUE sym), V_Subr1, DOC_symbolp) /*
  593. ::doc:symbolp::
  594. symbolp ARG
  595.  
  596. Returns t if ARG is a symbol.
  597. ::end:: */
  598. {
  599.     return(SYMBOLP(sym) ? sym_t : sym_nil);
  600. }
  601.  
  602. _PR VALUE cmd_setq(VALUE);
  603. DEFUN("setq", cmd_setq, subr_setq, (VALUE args), V_SF, DOC_setq) /*
  604. ::doc:setq::
  605. setq { SYMBOL FORM }...
  606.  
  607. Sets the value of each SYMBOL to the value of its corresponding FORM
  608. evaluated, returns the value of the last evaluation. ie,
  609.   (setq x 1 y (symbol-name 'nil))
  610.    => "nil"
  611.   x
  612.    => 1
  613.   y
  614.    => "nil"
  615. ::end:: */
  616. {
  617.     VALUE res = sym_nil;
  618.     GCVAL gcv_args;
  619.     PUSHGC(gcv_args, args);
  620.     while(CONSP(args) && CONSP(VCDR(args)) && SYMBOLP(VCAR(args)))
  621.     {
  622.     if(!(res = cmd_eval(VCAR(VCDR(args)))))
  623.         goto end;
  624.     if(!cmd_set(VCAR(args), res))
  625.     {
  626.         res = NULL;
  627.         goto end;
  628.     }
  629.     args = VCDR(VCDR(args));
  630.     }
  631. end:
  632.     POPGC;
  633.     return(res);
  634. }
  635.  
  636. _PR VALUE cmd_setq_default(VALUE);
  637. DEFUN("setq-default", cmd_setq_default, subr_setq_default, (VALUE args), V_SF, DOC_setq_default) /*
  638. ::doc:setq_default::
  639. setq-default { SYMBOL FORM }...
  640.  
  641. Sets the default value of each SYMBOL to the value of its corresponding
  642. FORM evaluated, returns the value of the last evaluation. See also setq.
  643. ::end:: */
  644. {
  645.     VALUE res = sym_nil;
  646.     GCVAL gcv_args;
  647.     PUSHGC(gcv_args, args);
  648.     while(CONSP(args) && CONSP(VCDR(args)) && SYMBOLP(VCAR(args)))
  649.     {
  650.     if(!(res = cmd_eval(VCAR(VCDR(args)))))
  651.         goto end;
  652.     if(!cmd_set_default(VCAR(args), res))
  653.     {
  654.         res = NULL;
  655.         goto end;
  656.     }
  657.     args = VCDR(VCDR(args));
  658.     }
  659. end:
  660.     POPGC;
  661.     return(res);
  662. }
  663.  
  664. _PR VALUE cmd_fset(VALUE, VALUE);
  665. DEFUN("fset", cmd_fset, subr_fset, (VALUE sym, VALUE val), V_Subr2, DOC_fset) /*
  666. ::doc:fset::
  667. fset SYMBOL VALUE
  668.  
  669. Sets the function value of SYMBOL to VALUE, returns VALUE.
  670. ::end:: */
  671. {
  672.     DECLARE1(sym, SYMBOLP);
  673.     VSYM(sym)->sym_Function = val;
  674.     return(val);
  675. }
  676.  
  677. _PR VALUE cmd_makunbound(VALUE);
  678. DEFUN("makunbound", cmd_makunbound, subr_makunbound, (VALUE sym), V_Subr1, DOC_makunbound) /*
  679. ::doc:makunbound::
  680. makunbound SYMBOL
  681.  
  682. Make SYMBOL have no value as a variable.
  683. ::end:: */
  684. {
  685.     DECLARE1(sym, SYMBOLP);
  686.     VSYM(sym)->sym_Value = NULL;
  687.     return(sym);
  688. }
  689.  
  690. _PR VALUE cmd_fmakunbound(VALUE);
  691. DEFUN("fmakunbound", cmd_fmakunbound, subr_fmakunbound, (VALUE sym), V_Subr1, DOC_fmakunbound) /*
  692. ::doc:fmakunbound::
  693. fmakunbound SYMBOL
  694.  
  695. Make the function slot of SYMBOL have no value.
  696. ::end:: */
  697. {
  698.     DECLARE1(sym, SYMBOLP);
  699.     VSYM(sym)->sym_Function = NULL;
  700.     return(sym);
  701. }
  702.  
  703. _PR VALUE cmd_let(VALUE);
  704. DEFUN("let", cmd_let, subr_let, (VALUE args), V_SF, DOC_let) /*
  705. ::doc:let::
  706. let (SYMBOL-BINDINGS...) BODY...
  707.  
  708. Binds temporary values to symbols while BODY is being evaluated.
  709. Each SYMBOL-BINDING is either a symbol, in which case that symbol is bound to
  710. nil, or a list. The symbol at the head of this list is bound to the progn'ed
  711. value of the forms making up the tail. ie,
  712.   (let
  713.       ((foo 1 2 3)
  714.        bar)
  715.     (cons foo bar))
  716.    => (3 . nil)
  717.  
  718. All values of the new bindings are evaluated before any symbols are bound.
  719. ::end:: */
  720. {
  721.     VALUE tmp, *store, oldvals, res = NULL;
  722.     int numsyms = 0;
  723.     if(!CONSP(args))
  724.     return(NULL);
  725.     oldvals = sym_nil;
  726.     for(tmp = VCAR(args); CONSP(tmp); numsyms++)
  727.     tmp = VCDR(tmp);
  728.     if(numsyms == 0)
  729.     return(cmd_progn(VCDR(args)));
  730.     else if((store = str_alloc(sizeof(VALUE) * numsyms)))
  731.     {
  732.     int i;
  733.     GCVAL gcv_args;
  734.     GCVALN gcv_store;
  735.     PUSHGC(gcv_args, args);
  736.     PUSHGCN(gcv_store, store, 0);
  737.     i = 0;
  738.     tmp = VCAR(args);
  739.     while(CONSP(tmp))
  740.     {
  741.         if(CONSP(VCAR(tmp)))
  742.         {
  743.         if(!(store[i] = cmd_progn(VCDR(VCAR(tmp)))))
  744.         {
  745.             POPGCN; POPGC;
  746.             goto end;
  747.         }
  748.         }
  749.         else
  750.         store[i] = sym_nil;
  751.         tmp = VCDR(tmp);
  752.         i++;
  753.         gcv_store.gcv_N = i;
  754.     }
  755.     POPGCN;
  756.     POPGC;
  757.     i = 0;
  758.     tmp = VCAR(args);
  759.     while(CONSP(tmp))
  760.     {
  761.         VALUE sym;
  762.         switch(VTYPE(VCAR(tmp)))
  763.         {
  764.         case V_Symbol:
  765.         sym = VCAR(tmp);
  766.         break;
  767.         case V_Cons:
  768.         sym = VCAR(VCAR(tmp));
  769.         if(SYMBOLP(sym))
  770.             break;
  771.         /* FALL THROUGH */
  772.         default:
  773.         cmd_signal(sym_error, LIST_1(MKSTR("No symbol to bind to in let")));
  774.         goto end;
  775.         }
  776.         if(!(oldvals = bind_symbol(oldvals, sym, store[i])))
  777.         goto end;
  778.         tmp = VCDR(tmp);
  779.         i++;
  780.     }
  781.     PUSHGC(gcv_args, oldvals);
  782.     res = cmd_progn(VCDR(args));
  783.     POPGC;
  784. end:
  785.     str_free(store);
  786.     unbind_symbols(oldvals);
  787.     return(res);
  788.     }
  789.     return(NULL);
  790. }
  791.  
  792. _PR VALUE cmd_letstar(VALUE);
  793. DEFUN("let*", cmd_letstar, subr_letstar, (VALUE args), V_SF, DOC_letstar) /*
  794. ::doc:letstar::
  795. let* (SYMBOL-BINDINGS...) BODY...
  796.  
  797. Binds temporary values to symbols while BODY is being evaluated.
  798. Each SYMBOL-BINDING is either a symbol, in which case that symbol is bound to
  799. nil, or a list. The symbol at the head of this list is bound to the progn'ed
  800. value of the forms making up the tail. ie,
  801.   (let*
  802.       ((foo 1 2 3)
  803.        bar)
  804.     (cons foo bar))
  805.    => (3 . nil)
  806.  
  807. The value of each binding is evaluated just before that symbol is bound,
  808. this means that,
  809.   (setq x 'foo)
  810.   (let*
  811.       ((x 10)
  812.        (y x))
  813.     (cons x y))
  814.    => (10 . 10)
  815. ::end:: */
  816. {
  817.     VALUE binds, res = NULL;
  818.     VALUE oldvals = sym_nil;
  819.     GCVAL gcv_args, gcv_oldvals;
  820.     if(!CONSP(args))
  821.     return(NULL);
  822.     binds = VCAR(args);
  823.     PUSHGC(gcv_args, args);
  824.     PUSHGC(gcv_oldvals, oldvals);
  825.     while(CONSP(binds))
  826.     {
  827.     if(CONSP(VCAR(binds)))
  828.     {
  829.         if(SYMBOLP(VCAR(VCAR(binds))))
  830.         {
  831.         VALUE val;
  832.         if(!(val = cmd_progn(VCDR(VCAR(binds)))))
  833.             goto error;
  834.         if(!(oldvals = bind_symbol(oldvals, VCAR(VCAR(binds)), val)))
  835.             goto error;
  836.         }
  837.     }
  838.     else
  839.     {
  840.         if(!(oldvals = bind_symbol(oldvals, VCAR(binds), sym_nil)))
  841.         goto error;
  842.     }
  843.     binds = VCDR(binds);
  844.     }
  845.     res = cmd_progn(VCDR(args));
  846. error:
  847.     POPGC; POPGC;
  848.     unbind_symbols(oldvals);
  849.     return(res);
  850. }
  851.  
  852. _PR VALUE cmd_get(VALUE, VALUE);
  853. DEFUN("get", cmd_get, subr_get, (VALUE sym, VALUE prop), V_Subr2, DOC_get) /*
  854. ::doc:get::
  855. get SYMBOL PROPERTY
  856.  
  857. Returns the value of SYMBOL's property PROPERTY. See `put'.
  858. ::end:: */
  859. {
  860.     VALUE plist;
  861.     DECLARE1(sym, SYMBOLP);
  862.     plist = VSYM(sym)->sym_PropList;
  863.     while(CONSP(plist) && CONSP(VCDR(plist)))
  864.     {
  865.     if(VCAR(plist) == prop)
  866.         return(VCAR(VCDR(plist)));
  867.     plist = VCDR(VCDR(plist));
  868.     }
  869.     return(sym_nil);
  870. }
  871.  
  872. _PR VALUE cmd_put(VALUE, VALUE, VALUE);
  873. DEFUN("put", cmd_put, subr_put, (VALUE sym, VALUE prop, VALUE val), V_Subr3, DOC_put) /*
  874. ::doc:put::
  875. put SYMBOL PROPERTY VALUE
  876.  
  877. Sets the value of SYMBOL's property PROPERTY to VALUE, this value can be
  878. retrieved with the `get' function.
  879. ::end:: */
  880. {
  881.     VALUE plist;
  882.     DECLARE1(sym, SYMBOLP);
  883.     plist = VSYM(sym)->sym_PropList;
  884.     while(CONSP(plist) && CONSP(VCDR(plist)))
  885.     {
  886.     if(VCAR(plist) == prop)
  887.     {
  888.         VCAR(VCDR(plist)) = val;
  889.         return(val);
  890.     }
  891.     plist = VCDR(VCDR(plist));
  892.     }
  893.     plist = cmd_cons(prop, cmd_cons(val, VSYM(sym)->sym_PropList));
  894.     if(plist)
  895.     {
  896.     VSYM(sym)->sym_PropList = plist;
  897.     return(val);
  898.     }
  899.     return(NULL);
  900. }
  901.  
  902. _PR VALUE cmd_make_local_variable(VALUE);
  903. DEFUN("make-local-variable", cmd_make_local_variable, subr_make_local_variable, (VALUE sym), V_Subr1, DOC_make_local_variable) /*
  904. ::doc:make_local_variable::
  905. make-local-variable SYMBOL
  906.  
  907. Gives the variable SYMBOL a buffer-local binding in the current buffer. It
  908. will be the same as the default value to start with. If the current buffer
  909. alread has a buffer-local binding for SYMBOL nothing happens.
  910. Returns SYMBOL.
  911. ::end:: */
  912. {
  913.     VALUE slot;
  914.     TX *tx = curr_vw->vw_Tx;
  915.     DECLARE1(sym, SYMBOLP);
  916.     VSYM(sym)->sym_Flags |= SF_BUFFER_LOCAL;
  917.     slot = cmd_assq(sym, tx->tx_LocalVariables);
  918.     if(!slot || !CONSP(slot))
  919.     {
  920.     /* Need to create a binding. */
  921.     tx->tx_LocalVariables = cmd_cons(cmd_cons(sym, VSYM(sym)->sym_Value),
  922.                      tx->tx_LocalVariables);
  923.     }
  924.     return(sym);
  925. }
  926.  
  927. _PR VALUE cmd_make_variable_buffer_local(VALUE);
  928. DEFUN("make-variable-buffer-local", cmd_make_variable_buffer_local, subr_make_variable_buffer_local, (VALUE sym), V_Subr1, DOC_make_variable_buffer_local) /*
  929. ::doc:make_variable_buffer_local::
  930. make-variable-buffer-local SYMBOL
  931.  
  932. Marks the variable SYMBOL as being automatically buffer-local. Any attempts
  933. at setting SYMBOL result in the current buffer being given its own binding.
  934. Returns SYMBOL.
  935. ::end:: */
  936. {
  937.     DECLARE1(sym, SYMBOLP);
  938.     VSYM(sym)->sym_Flags |= (SF_BUFFER_LOCAL | SF_SET_BUFFER_LOCAL);
  939.     return(sym);
  940. }
  941.  
  942. _PR VALUE cmd_buffer_variables(VALUE);
  943. DEFUN("buffer-variables", cmd_buffer_variables, subr_buffer_variables, (VALUE tx), V_Subr1, DOC_buffer_variables) /*
  944. ::doc:buffer_variables::
  945. buffer-variables [BUFFER]
  946.  
  947. Returns a list of (SYMBOL . VALUE) bindings which take effect when the
  948. current buffer is BUFFER.
  949. ::end:: */
  950. {
  951.     if(!BUFFERP(tx))
  952.     tx = VAL(curr_vw->vw_Tx);
  953.     return(VTX(tx)->tx_LocalVariables);
  954. }
  955.  
  956. _PR VALUE cmd_kill_all_local_variables(VALUE);
  957. DEFUN("kill-all-local-variables", cmd_kill_all_local_variables, subr_kill_all_local_variables, (VALUE tx), V_Subr1, DOC_kill_all_local_variables) /*
  958. ::doc:kill_all_local_variables::
  959. kill-all-local-variables [BUFFER]
  960.  
  961. Remove all buffer-local variables from BUFFER.
  962. ::end:: */
  963. {
  964.     if(!BUFFERP(tx))
  965.     tx = VAL(curr_vw->vw_Tx);
  966.     VTX(tx)->tx_LocalVariables = sym_nil;
  967.     return(tx);
  968. }
  969.  
  970. _PR VALUE cmd_kill_local_variable(VALUE, VALUE);
  971. DEFUN("kill-local-variable", cmd_kill_local_variable, subr_kill_local_variable, (VALUE sym, VALUE tx), V_Subr2, DOC_kill_local_variable) /*
  972. ::doc:kill_local_variable::
  973. kill-local-variable SYMBOL [BUFFER]
  974.  
  975. Remove the buffer-local value of the symbol SYMBOL in the specified buffer.
  976. ::end:: */
  977. {
  978.     VALUE list;
  979.     DECLARE1(sym, SYMBOLP);
  980.     if(!BUFFERP(tx))
  981.     tx = VAL(curr_vw->vw_Tx);
  982.     list = VTX(tx)->tx_LocalVariables;
  983.     VTX(tx)->tx_LocalVariables = sym_nil;
  984.     while(CONSP(list))
  985.     {
  986.     VALUE nxt = VCDR(list);
  987.     if(VCAR(list) != sym)
  988.     {
  989.         VCDR(list) = VTX(tx)->tx_LocalVariables;
  990.         VTX(tx)->tx_LocalVariables = list;
  991.     }
  992.     list = nxt;
  993.     }
  994.     return(sym);
  995. }
  996.  
  997. _PR VALUE cmd_apropos(VALUE, VALUE, VALUE);
  998. DEFUN("apropos", cmd_apropos, subr_apropos, (VALUE re, VALUE pred, VALUE ob), V_Subr3, DOC_apropos) /*
  999. ::doc:apropos::
  1000. apropos REGEXP [PREDICATE] [OBARRAY]
  1001.  
  1002. Returns a list of symbols from OBARRAY (or the default) whose print-name
  1003. matches the regular-expression REGEXP. If PREDICATE is given and non-nil,
  1004. each symbol which matches is applied to the function PREDICATE, if the value
  1005. is non-nil it is considered a match.
  1006. ::end:: */
  1007. {
  1008.     regexp *prog;
  1009.     DECLARE1(re, STRINGP);
  1010.     if(!VECTORP(ob))
  1011.     ob = obarray;
  1012.     prog = regcomp(VSTR(re));
  1013.     if(prog)
  1014.     {
  1015.     VALUE last = sym_nil;
  1016.     int i;
  1017.     GCVAL gcv_last, gcv_ob, gcv_pred;
  1018.     PUSHGC(gcv_last, last);
  1019.     PUSHGC(gcv_ob, ob);
  1020.     PUSHGC(gcv_pred, pred);
  1021.     for(i = 0; i < VVECT(ob)->vc_Size; i++)
  1022.     {
  1023.         VALUE chain = VVECT(ob)->vc_Array[i];
  1024.         while(SYMBOLP(chain))
  1025.         {
  1026.         if(regexec(prog, VSTR(VSYM(chain)->sym_Name)))
  1027.         {
  1028.             if(pred && !NILP(pred))
  1029.             {
  1030.             VALUE tmp;
  1031.             if(!(tmp = funcall(pred, LIST_1(chain)))
  1032.                || NILP(tmp))
  1033.             {
  1034.                 goto next;
  1035.             }
  1036.             }
  1037.             last = cmd_cons(chain, last);
  1038.         }
  1039. next:
  1040.         chain = VSYM(chain)->sym_Next;
  1041.         }
  1042.     }
  1043.     POPGC; POPGC; POPGC;
  1044.     free(prog);
  1045.     return(last);
  1046.     }
  1047.     return(NULL);
  1048. }
  1049.  
  1050. _PR VALUE cmd_set_const_variable(VALUE sym, VALUE stat);
  1051. DEFUN("set-const-variable", cmd_set_const_variable, subr_set_const_variable, (VALUE sym, VALUE stat), V_Subr2, DOC_set_const_variable) /*
  1052. ::doc:set_const_variable::
  1053. set-const-variable SYMBOL
  1054.  
  1055. Flags that the value of SYMBOL may not be changed.
  1056. ::end:: */
  1057. {
  1058.     DECLARE1(sym, SYMBOLP);
  1059.     if(NILP(stat))
  1060.     VSYM(sym)->sym_Flags |= SF_CONSTANT;
  1061.     else
  1062.     VSYM(sym)->sym_Flags &= ~SF_CONSTANT;
  1063.     return(sym);
  1064. }
  1065.  
  1066. _PR VALUE cmd_const_variable_p(VALUE sym);
  1067. DEFUN("const-variable-p", cmd_const_variable_p, subr_const_variable_p, (VALUE sym), V_Subr1, DOC_const_variable_p) /*
  1068. ::doc:const_variable_p::
  1069. const-variable-p SYMBOL
  1070.  
  1071. Return t is `set-const-variable' has been called on SYMBOL.
  1072. ::end:: */
  1073. {
  1074.     DECLARE1(sym, SYMBOLP);
  1075.     if(VSYM(sym)->sym_Flags & SF_CONSTANT)
  1076.     return(sym_t);
  1077.     return(sym_nil);
  1078. }
  1079.  
  1080. _PR VALUE cmd_trace(VALUE sym);
  1081. DEFUN_INT("trace", cmd_trace, subr_trace, (VALUE sym), V_Subr1, DOC_trace, "aFunction to trace") /*
  1082. ::doc:trace::
  1083. trace SYMBOL
  1084.  
  1085. Flag that whenever SYMBOL is evaluated (as a variable or a function) the
  1086. debugger is entered.
  1087. ::end:: */
  1088. {
  1089.     DECLARE1(sym, SYMBOLP);
  1090.     VSYM(sym)->sym_Flags |= SF_DEBUG;
  1091.     return(sym);
  1092. }
  1093.  
  1094. _PR VALUE cmd_untrace(VALUE sym);
  1095. DEFUN_INT("untrace", cmd_untrace, subr_untrace, (VALUE sym), V_Subr1, DOC_untrace, "aFunction to untrace") /*
  1096. ::doc:untrace::
  1097. untrace SYMBOL
  1098.  
  1099. Cancel the effect of (trace SYMBOL).
  1100. ::end:: */
  1101. {
  1102.     DECLARE1(sym, SYMBOLP);
  1103.     VSYM(sym)->sym_Flags &= ~SF_DEBUG;
  1104.     return(sym);
  1105. }
  1106.  
  1107. _PR VALUE var_obarray(VALUE val);
  1108. DEFUN("obarray", var_obarray, subr_obarray, (VALUE val), V_Var, DOC_obarray) /*
  1109. ::doc:obarray::
  1110. The obarray used by the Lisp reader.
  1111. ::end:: */
  1112. {
  1113.     if(val && VECTORP(val))
  1114.     obarray = val;
  1115.     return(obarray);
  1116. }
  1117.  
  1118. int
  1119. symbols_init(void)
  1120. {
  1121.     obarray = cmd_make_obarray(make_number(OBSIZE));
  1122.     if(obarray)
  1123.     {
  1124.     mark_static(&obarray);
  1125.  
  1126.     /* fiddly details of initialising the first symbol */
  1127.     sym_nil = cmd_intern(MKSTR("nil"), obarray);
  1128.     mark_static(&sym_nil);
  1129.     VSYM(sym_nil)->sym_Value = sym_nil;
  1130.     VSYM(sym_nil)->sym_PropList = sym_nil;
  1131.     VSYM(sym_nil)->sym_Flags &= SF_CONSTANT;
  1132.  
  1133.     INTERN(sym_t, "t");
  1134.     VSYM(sym_t)->sym_Value = sym_t;
  1135.     VSYM(sym_t)->sym_Flags &= SF_CONSTANT;
  1136.  
  1137.     INTERN(sym_variable_documentation, "variable-documentation");
  1138.     ADD_SUBR(subr_make_symbol);
  1139.     ADD_SUBR(subr_make_obarray);
  1140.     ADD_SUBR(subr_find_symbol);
  1141.     ADD_SUBR(subr_intern_symbol);
  1142.     ADD_SUBR(subr_intern);
  1143.     ADD_SUBR(subr_unintern);
  1144.     ADD_SUBR(subr_symbol_value);
  1145.     ADD_SUBR(subr_set);
  1146.     ADD_SUBR(subr_setplist);
  1147.     ADD_SUBR(subr_symbol_name);
  1148.     ADD_SUBR(subr_symbol_function);
  1149.     ADD_SUBR(subr_default_value);
  1150.     ADD_SUBR(subr_default_boundp);
  1151.     ADD_SUBR(subr_set_default);
  1152.     ADD_SUBR(subr_fboundp);
  1153.     ADD_SUBR(subr_boundp);
  1154.     ADD_SUBR(subr_symbol_plist);
  1155.     ADD_SUBR(subr_gensym);
  1156.     ADD_SUBR(subr_symbolp);
  1157.     ADD_SUBR(subr_setq);
  1158.     ADD_SUBR(subr_setq_default);
  1159.     ADD_SUBR(subr_fset);
  1160.     ADD_SUBR(subr_makunbound);
  1161.     ADD_SUBR(subr_fmakunbound);
  1162.     ADD_SUBR(subr_let);
  1163.     ADD_SUBR(subr_letstar);
  1164.     ADD_SUBR(subr_get);
  1165.     ADD_SUBR(subr_put);
  1166.     ADD_SUBR(subr_make_local_variable);
  1167.     ADD_SUBR(subr_make_variable_buffer_local);
  1168.     ADD_SUBR(subr_buffer_variables);
  1169.     ADD_SUBR(subr_kill_all_local_variables);
  1170.     ADD_SUBR(subr_kill_local_variable);
  1171.     ADD_SUBR(subr_apropos);
  1172.     ADD_SUBR(subr_set_const_variable);
  1173.     ADD_SUBR(subr_const_variable_p);
  1174.     ADD_SUBR(subr_trace);
  1175.     ADD_SUBR(subr_untrace);
  1176.     ADD_SUBR(subr_obarray);
  1177.     return(TRUE);
  1178.     }
  1179.     return(FALSE);
  1180. }
  1181.  
  1182. void
  1183. symbols_kill(void)
  1184. {
  1185.     SymbolBlk *sb = symbol_block_chain;
  1186.     while(sb)
  1187.     {
  1188.     SymbolBlk *nxt = sb->sb_Next;
  1189.     myfree(sb);
  1190.     sb = nxt;
  1191.     }
  1192.     symbol_block_chain = NULL;
  1193. }
  1194.